home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / win / tclWinTest.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  3.1 KB  |  131 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclWinTest.c --
  3.  *
  4.  *    Contains commands for platform specific tests on Windows.
  5.  *
  6.  * Copyright (c) 1996 Sun Microsystems, Inc.
  7.  *
  8.  * See the file "license.terms" for information on usage and redistribution
  9.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  * SCCS: @(#) tclWinTest.c 1.2 97/03/20 15:04:12
  12.  */
  13.  
  14. #include "tclInt.h"
  15. #include "tclPort.h"
  16.  
  17. /*
  18.  * Forward declarations of procedures defined later in this file:
  19.  */
  20. int            TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
  21. static int        TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
  22.                 Tcl_Interp *interp, int argc, char **argv));
  23.  
  24. /*
  25.  *----------------------------------------------------------------------
  26.  *
  27.  * TclplatformtestInit --
  28.  *
  29.  *    Defines commands that test platform specific functionality for
  30.  *    Unix platforms.
  31.  *
  32.  * Results:
  33.  *    A standard Tcl result.
  34.  *
  35.  * Side effects:
  36.  *    Defines new commands.
  37.  *
  38.  *----------------------------------------------------------------------
  39.  */
  40.  
  41. int
  42. TclplatformtestInit(interp)
  43.     Tcl_Interp *interp;        /* Interpreter to add commands to. */
  44. {
  45.     /*
  46.      * Add commands for platform specific tests for Windows here.
  47.      */
  48.  
  49.     Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
  50.             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  51.     return TCL_OK;
  52. }
  53.  
  54. /*
  55.  *----------------------------------------------------------------------
  56.  *
  57.  * TesteventloopCmd --
  58.  *
  59.  *    This procedure implements the "testeventloop" command. It is
  60.  *    used to test the Tcl notifier from an "external" event loop
  61.  *    (i.e. not Tcl_DoOneEvent()).
  62.  *
  63.  * Results:
  64.  *    A standard Tcl result.
  65.  *
  66.  * Side effects:
  67.  *    None.
  68.  *
  69.  *----------------------------------------------------------------------
  70.  */
  71.  
  72. static int
  73. TesteventloopCmd(clientData, interp, argc, argv)
  74.     ClientData clientData;        /* Not used. */
  75.     Tcl_Interp *interp;            /* Current interpreter. */
  76.     int argc;                /* Number of arguments. */
  77.     char **argv;            /* Argument strings. */
  78. {
  79.     static int *framePtr = NULL; /* Pointer to integer on stack frame of
  80.                   * innermost invocation of the "wait"
  81.                   * subcommand. */
  82.  
  83.    if (argc < 2) {
  84.     Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
  85.                 " option ... \"", (char *) NULL);
  86.         return TCL_ERROR;
  87.     }
  88.     if (strcmp(argv[1], "done") == 0) {
  89.     *framePtr = 1;
  90.     } else if (strcmp(argv[1], "wait") == 0) {
  91.     int *oldFramePtr;
  92.     int done;
  93.     MSG msg;
  94.     int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
  95.  
  96.     /*
  97.      * Save the old stack frame pointer and set up the current frame.
  98.      */
  99.  
  100.     oldFramePtr = framePtr;
  101.     framePtr = &done;
  102.  
  103.     /*
  104.      * Enter a standard Windows event loop until the flag changes.
  105.      * Note that we do not explicitly call Tcl_ServiceEvent().
  106.      */
  107.  
  108.     done = 0;
  109.     while (!done) {
  110.         if (!GetMessage(&msg, NULL, 0, 0)) {
  111.         /*
  112.          * The application is exiting, so repost the quit message
  113.          * and start unwinding.
  114.          */
  115.  
  116.         PostQuitMessage(msg.wParam);
  117.         break;
  118.         }
  119.         TranslateMessage(&msg);
  120.         DispatchMessage(&msg);
  121.     }
  122.     (void) Tcl_SetServiceMode(oldMode);
  123.     framePtr = oldFramePtr;
  124.     } else {
  125.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  126.         "\": must be done or wait", (char *) NULL);
  127.     return TCL_ERROR;
  128.     }
  129.     return TCL_OK;
  130. }
  131.